home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / twars.arc / EXTERN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  30KB  |  1,113 lines
  1. PROGRAM Maintenance;
  2.  
  3. (*$C-*) (*$v-*)
  4. (*$I COMMON.PAS*)
  5.  
  6. CONST
  7.       fs = 'TWDATA.DAT';
  8.  
  9. TYPE
  10.      users = RECORD
  11.                fa,                                   { Game Handle       }
  12.                fareal               : string[41];    { Real Name         }
  13.                fb,
  14.                fc,
  15.                fd,
  16.                fe,
  17.                ff,
  18.                fg,
  19.                fh,
  20.                fi,
  21.                fj,
  22.                fk,
  23.                fl,
  24.                fr,
  25.                fp,
  26.                fm,
  27.                fo,
  28.                fq,
  29.                ft,
  30.                fv                   : INTEGER;
  31.                newcash              : real;          { Converted to real }
  32.              END;
  33.  
  34.      teamrec  = RECORD
  35.                name                 : string[41];    { Team name         }
  36.                captain              : string[41];    { Team captain      }
  37.                datemade             : string[8];     { creation date     }
  38.                password             : string[8];     { team password     }
  39.                rank                 : real;          {    -not/used-     }
  40.                kills                : integer;       { Combat medals     }
  41.              END;
  42.  
  43.  
  44. VAR
  45.     smg          : FILE OF smr;
  46.     pnn          : STRING[41];
  47.     rteams,
  48.     tteams       : teamrec;
  49.     teams        : file of teamrec;
  50.     y,
  51.     a,
  52.     mo,
  53.     d,
  54.     go,
  55.     pn,
  56.     pd,
  57.     s2,
  58.     st,
  59.     g2,
  60.     prr          : INTEGER;
  61.     ay,
  62.     tt,
  63.     lp,
  64.     ls,
  65.     lt1,
  66.     ll1          : INTEGER;
  67.     userf        : FILE OF users;
  68.     userz,
  69.     usery,
  70.     userr,
  71.     usert        : users;
  72.     e            : ARRAY[1..6] OF INTEGER;
  73.     m,
  74.     n,
  75.     pub,
  76.     c1,
  77.     h            : ARRAY[0..3] OF REAL;
  78.     s            : ARRAY[0..1000,0..1] OF INTEGER;
  79.     srr          : ARRAY[0..3,0..1] OF REAL;
  80.     g            : ARRAY[0..9,0..1]   OF INTEGER;
  81.     ended,
  82.     done         : BOOLEAN;
  83.     aim          : STR;
  84.     msger        : TEXT;
  85.  
  86. FUNCTION sgn(i:INTEGER): INTEGER;
  87. BEGIN
  88.   IF i>0 THEN
  89.     sgn := 1
  90.   ELSE
  91.     IF i<0 THEN
  92.       sgn := -1
  93.     ELSE
  94.       sgn := 0;
  95. END;
  96.  
  97. PROCEDURE readin(i:INTEGER;VAR user:users);
  98. BEGIN
  99.   SEEK(userf,i);
  100.   READ(userf,user);
  101. END;
  102.  
  103. PROCEDURE writeout(i:INTEGER;user:users);
  104. BEGIN
  105.   SEEK(userf,i);
  106.   WRITE(userf,user);
  107. END;
  108.  
  109.  
  110. PROCEDURE getdate;
  111.  
  112.   VAR
  113.       a,code    : INTEGER;
  114.       datea : STR;
  115. BEGIN
  116.     d := daynum(date)-1094;
  117. END;
  118.  
  119.  
  120. PROCEDURE ssm(dest:INTEGER; s:STR);
  121.  
  122. VAR 
  123.     x: smr;
  124.     e,cp,t: INTEGER;
  125.     u: userrec;
  126. BEGIN
  127.   (*$I-*)
  128.   RESET(smg);(*$I+*)
  129.   IF IORESULT<>0 THEN
  130.     REWRITE(smg);
  131.   e := FILESIZE(smg);
  132.   IF e=0 THEN
  133.     cp := 0
  134.   ELSE
  135.     BEGIN
  136.       t := e-1;
  137.       SEEK(smg,t);
  138.       READ(smg,x);
  139.       WHILE (t>0) AND (x.destin=-1) DO
  140.         BEGIN
  141.           t := t-1;
  142.           SEEK(smg,t);
  143.           READ(smg,x);
  144.         END;
  145.       cp := t+1;
  146.     END;
  147.   SEEK(smg,cp);
  148.   x.msg := s;
  149.   x.destin := dest;
  150.   WRITE(smg,x);
  151.   CLOSE(smg);
  152.   IF (dest=pn) THEN
  153.     thisuser.option := thisuser.option+[smw];
  154. END;
  155.  
  156. PROCEDURE message(p,po,n,n1: INTEGER);
  157. BEGIN
  158.   IF po < 2 THEN
  159.     ssm(p,'The Ferrengi destroyed '+cstr(n)+' of your fighters.')
  160.   ELSE
  161.     BEGIN
  162.       readin(po,usert);
  163.       IF n1=0 THEN
  164.         WITH usert DO
  165.           ssm(p,fa+' destroyed '+cstr(n)+' of your fighters.')
  166.       ELSE
  167.         WITH usert DO
  168.           ssm(p,fa+' destroyed '+cstr(n1)+' armor points and '
  169.               +cstr(n)+' of your fighters.');
  170.     END;
  171. END;
  172.  
  173.  
  174. PROCEDURE removeship(p:INTEGER);
  175.  
  176.   VAR
  177.       r,b  : INTEGER;
  178.       done : BOOLEAN;
  179. BEGIN
  180.   readin(p,usery);
  181.   r := usery.ff;
  182.   IF r<>0 THEN
  183.       BEGIN
  184.         readin(lp+r,usery);
  185.         a := usery.fi;
  186.         IF a<>0 THEN
  187.             IF a=p THEN
  188.               BEGIN
  189.                 readin(a,usery);
  190.                 b := usery.fo;
  191.                 readin(lp+r,usery);
  192.                 usery.fi := b;
  193.                 writeout(lp+r,usery);
  194.               END
  195.             ELSE
  196.               BEGIN
  197.                 done := FALSE;
  198.                 readin(a,usert);
  199.                 REPEAT
  200.                   IF usert.fo = p THEN
  201.                     BEGIN
  202.                       b := a;
  203.                       done := TRUE;
  204.                     END;
  205.                   a := usert.fo;
  206.                   readin(a,usert);
  207.                 UNTIL done;
  208.                 a := usert.fo;
  209.                 readin(b,usert);
  210.                 usert.fo := a;
  211.                 writeout(b,usert);
  212.               END;
  213.       END;
  214. END;
  215.  
  216. PROCEDURE rsm;
  217.  
  218. VAR
  219.     x: smr;
  220.     i: INTEGER;
  221. BEGIN
  222.   (*$I-*)
  223.   RESET(smg); (*$I+*)
  224.   IF IORESULT=0 THEN
  225.       BEGIN
  226.         i := 0;
  227.         REPEAT
  228.           IF i<=FILESIZE(smg)-1 THEN
  229.             BEGIN
  230.               SEEK(smg,i);
  231.               READ(smg,x);
  232.             END;
  233.           WHILE (i<FILESIZE(smg)-1) AND (x.destin<>pn) DO
  234.             BEGIN
  235.               i := i+1;
  236.               SEEK(smg,i);
  237.               READ(smg,x);
  238.             END;
  239.           IF (x.destin=pn) AND (i<=FILESIZE(smg)-1) THEN
  240.             BEGIN
  241.               writeln(x.msg);
  242.               SEEK(smg,i);
  243.               x.destin := -1;
  244.               WRITE(smg,x);
  245.             END;
  246.           i := i+1;
  247.         UNTIL (i>FILESIZE(smg)-1) OR hangup;
  248.         CLOSE(smg);
  249.       END;
  250. END;
  251.  
  252. PROCEDURE DELETE(p: INTEGER);
  253.  
  254.   VAR
  255.       l: INTEGER;
  256. BEGIN
  257.   readin(p,usert);
  258.   writeln('Terminating '+usert.fa+' ('+cstr(p)+')...');
  259.   removeship(p);
  260.   readin(p,usert);
  261.   usert.fm := 0;
  262.   usert.fr := 0;
  263.   usert.fareal := 'Maint deleted record';
  264.   usert.fo := 0;
  265.   writeout(p,usert);
  266.   FOR l:=lp+1 TO ls DO
  267.     BEGIN
  268.       readin(l,usert);
  269.       IF usert.fm=p THEN
  270.         BEGIN
  271.           usert.fm := -2;
  272.           writeout(l,usert);
  273.         END;
  274.     END;
  275.   pn := p;
  276.   rsm;
  277.   FOR l:=2 TO lp DO
  278.     BEGIN
  279.       readin(l,usert);
  280.       IF usert.fc=p THEN
  281.         BEGIN
  282.           usert.fc := -98;
  283.           writeout(l,usert);
  284.         END;
  285.     END;
  286. END;
  287.  
  288. PROCEDURE shortest(a,b: INTEGER);
  289.  
  290.   VAR
  291.       n,c,l,m : INTEGER;
  292.       found   : BOOLEAN;
  293. BEGIN
  294.   n := 1;
  295.   c := b;
  296.   IF a=b THEN
  297.     BEGIN
  298.       s[0,0] := a;
  299.       s[0,1] := 0;
  300.       s[a,1] := 0;
  301.     END
  302.   ELSE
  303.       BEGIN
  304.         FOR l:=1 TO 1000 DO
  305.           FOR m:=0 TO 1 DO
  306.             s[l,m] := 0;
  307.         s[a,1] := 1;
  308.         found := FALSE;
  309.         REPEAT
  310.           l := 1;
  311.           REPEAT
  312.             IF s[l,1]=n THEN
  313.               BEGIN
  314.                 readin(l+lp,usert);
  315.                 e[1] := usert.fb;
  316.                 e[2] := usert.fc;
  317.                 e[3] := usert.fd;
  318.                 e[4] := usert.fe;
  319.                 e[5] := usert.ff;
  320.                 e[6] := usert.fg;
  321.                 FOR m:=1 TO 6 DO
  322.                   IF e[m]<>0 THEN
  323.                     IF s[e[m],1]=0 THEN
  324.                       BEGIN
  325.                         s[e[m],1] := n+1;
  326.                         s[e[m],0] := l;
  327.                         IF e[m]=b THEN
  328.                           found := TRUE;
  329.                       END;
  330.               END;
  331.             l := l+1;
  332.           UNTIL found OR (l>1000);
  333.           IF NOT found THEN
  334.             n := n+1;
  335.         UNTIL found OR (n=2000);
  336.         IF NOT found THEN
  337.             BEGIN
  338.             sysoplog('*** Error - Sector path not found - from sector'
  339.                      +cstr(a)+' to sector'+cstr(b));
  340.             writeln('*** Error - Sector path not found - from sector'+cstr(a)+
  341.                   ' to sector'+cstr(b));
  342.             s[a,1] := 0;
  343.             ended := TRUE;
  344.           END
  345.         ELSE
  346.           REPEAT
  347.             s[s[c,0],1] := c;
  348.             c := s[c,0];
  349.             IF s[c,0]=0 THEN
  350.               s[b,1] := 0;
  351.           UNTIL s[c,0]=0;
  352.       END;
  353. END;
  354.  
  355. PROCEDURE picksec(VAR v: INTEGER);
  356. BEGIN
  357.   v := RANDOM(3)+1;
  358.     IF v<>1 THEN
  359.       v := RANDOM(1000)+1
  360.     ELSE
  361.       BEGIN
  362.         v := RANDOM(8)+1;
  363.         case v of
  364.         1 : v := 80;
  365.         2 : v := 81;
  366.         3 : v := 999;
  367.         4 : v := 82;
  368.         5 : v := 789;
  369.         6 : v := 86;
  370.         7 : v := 689;
  371.         8 : v := 754;
  372.       END;
  373.     end;
  374. END;
  375.  
  376. PROCEDURE rank(VAR p: INTEGER);
  377.  
  378.   VAR 
  379.       l,g0,h0,f0,n,o,j0,k0,l0,v,c : INTEGER;
  380.       done                        : BOOLEAN;
  381. BEGIN
  382.   FOR l:=2 TO lp DO
  383.     BEGIN
  384.       readin(l,usert);
  385.       IF usert.fm=0 THEN
  386.         BEGIN
  387.           usert.fv := -1;
  388.           writeout(l,usert);
  389.         END
  390.       ELSE
  391.         IF usert.fc<>0 THEN
  392.           BEGIN
  393.             usert.fv := 0;
  394.             writeout(l,usert);
  395.           END
  396.         ELSE
  397.           BEGIN
  398.             g0 := usert.fg + usert.fe;
  399.             h0 := usert.fh;
  400.             f0 := usert.fi;
  401.             j0 := usert.fj;
  402.             k0 := usert.fk;
  403.             l0 := usert.fl;
  404.             v := g0*2+h0*25+ROUND(f0*2.5)+j0*5+ROUND(k0*8.75)+ROUND(l0/20);
  405.             usert.fv := v;
  406.             writeout(l,usert);
  407.           END;
  408.     END;
  409.   p := 0;
  410.   FOR l:=2 TO lp DO
  411.     BEGIN
  412.       readin(l,usert);
  413.       v := usert.fv;
  414.       IF v<>-1 THEN
  415.           BEGIN
  416.             n := p;
  417.             o := 0;
  418.             done := FALSE;
  419.             IF p=0 THEN
  420.               BEGIN
  421.                 p := l;
  422.                 usert.ft := -1;
  423.                 writeout(l,usert);
  424.               END
  425.             ELSE
  426.               REPEAT
  427.                 readin(n,usert);
  428.                 IF (v>usert.fv) AND (o=0) THEN
  429.                   BEGIN
  430.                     readin(l,usert);
  431.                     usert.ft := p;
  432.                     writeout(l,usert);
  433.                     p := l;
  434.                     done := TRUE;
  435.                   END
  436.                 ELSE
  437.                   IF v>usert.fv THEN
  438.                     BEGIN
  439.                       readin(o,usert);
  440.                       c := usert.ft;
  441.                       usert.ft := l;
  442.                       writeout(o,usert);
  443.                       readin(l,usert);
  444.                       usert.ft := c;
  445.                       writeout(l,usert);
  446.                       done := TRUE;
  447.                     END
  448.                   ELSE
  449.                     IF usert.ft=-1 THEN
  450.                       BEGIN
  451.                         readin(n,usert);
  452.                         usert.ft := l;
  453.                         writeout(n,usert);
  454.                         readin(l,usert);
  455.                         usert.ft := -1;
  456.                         writeout(l,usert);
  457.                         done := TRUE;
  458.                       END
  459.                     ELSE
  460.                       BEGIN
  461.                         o := n;
  462.                         n := usert.ft;
  463.                       END;
  464.               UNTIL done;
  465.           END;
  466.     END;
  467. END;
  468.  
  469. PROCEDURE killed(pn,p: INTEGER);
  470.  
  471.   VAR
  472.       l : INTEGER;
  473. BEGIN
  474.   removeship(p);                     (* P is dead guy, PN is killer *)
  475.   readin(p,usert);
  476.   usert.fc := pn;
  477.   usert.ff := 0;
  478.   writeout(p,usert);
  479.   FOR l:=lp+1 TO ls DO
  480.     BEGIN
  481.       readin(l,usert);
  482.       IF usert.fm=p THEN
  483.         BEGIN
  484.           usert.fm := -2;
  485.           writeout(l,usert);
  486.         END;
  487.     END;
  488. END;
  489.  
  490. PROCEDURE addmsg(i:STR);
  491. BEGIN
  492.   WRITELN(msger,i);
  493. END;
  494.  
  495. PROCEDURE cattack(go,p,f:INTEGER);
  496.  
  497.   VAR
  498.       r,k,c13,r13,v,n,pn : INTEGER;
  499. BEGIN
  500.   IF f>g[go,1] THEN
  501.     f := g[go,1];
  502.   IF (p>1) AND (p<=lp) THEN
  503.       BEGIN
  504.         c13 := g[go,0]+lp;
  505.         readin(c13,usert);
  506.         IF (usert.fm=-1) AND (f>=1) THEN
  507.           BEGIN
  508.             readin(p,usert);
  509.             IF usert.ff=c13-lp THEN
  510.               BEGIN
  511.                 r := 0;
  512.                 k := 0;
  513.                 REPEAT
  514.                   v :=random(2);
  515.                   IF v=1 THEN
  516.                     r := r+1
  517.                   ELSE
  518.                     k := k+1;
  519.                 UNTIL (r>usert.fg) OR (k>=f);
  520.                 g[go,1] := g[go,1]-k;
  521.                 readin(c13,usert);
  522.                 usert.fl := g[go,1];
  523.                 writeout(c13,usert);
  524.                 IF g[go,1]<1 THEN
  525.                   BEGIN
  526.                     usert.fm := 0;
  527.                     usert.fl := 0;
  528.                     writeout(c13,usert);
  529.                     g[go,0] := 0;
  530.                     g[go,1] := 0;
  531.                   END;
  532.                 readin(p,usert);
  533.                 f := usert.fg-r;
  534.                 n := r;
  535.                 r13 := r;
  536.                 pn := -1;
  537.                 message(p,pn,n,0);
  538.                 IF f>0 THEN
  539.                   BEGIN
  540.                     readin(p,usert);
  541.                     usert.fg := f;
  542.                     writeout(p,usert);
  543.                   END
  544.                 ELSE
  545.                   killed(pn,p);
  546.                 readin(p,usert);
  547.                 IF g[go,0]=0 THEN
  548.                 begin
  549.                 addmsg(usert.fa+' bravely fought off an attack by the Ferrengi!');
  550.                   sysoplog(usert.fa+': lost '+cstr(k)+
  551.                     ', destroyed '+cstr(r13)+' Ferrengi. (Ferrengi wiped out)');
  552.                 end
  553.                 ELSE
  554.                   IF usert.fc=-1 THEN
  555.                   begin
  556.                   addmsg(usert.fa+' fell prey to the Ferrengi and was destroyed!');
  557.                       sysoplog(usert.fa+': lost '+cstr(k)+
  558.                         ', destroyed '+cstr(r13)+' (Player destroyed)');
  559.                   end;
  560.               END;
  561.           END;
  562.       END;
  563. END;
  564.  
  565. PROCEDURE movecabal(go,a,b:INTEGER);
  566.  
  567. (*35090/ MOVE GROUP CABAL (GROUP G) FROM SECTOR A TO SECTOR B (NEXT TO EACH OTHER)*)
  568.  
  569.   VAR
  570.       t1,
  571.       n,p,v,k,l: INTEGER;
  572. BEGIN
  573.   writeln('*** MoveCabal - Group ',go,' of ',g[go,1],' fighters moves from sect ',a,' to ',b);
  574.   IF (a>=1) AND (b>=1) AND (a<=ls-lp) AND (b<=ls-lp) AND (a<>b) THEN
  575.       BEGIN
  576.         n := g[go,1];
  577.         readin(a+lp,usert);
  578.         IF usert.fm<>-1 THEN
  579.             BEGIN
  580.               g[go,0] := 0;
  581.               g[go,1] := 0;
  582.             END
  583.         ELSE
  584.             BEGIN
  585.               IF usert.fl<=n THEN
  586.                 BEGIN
  587.                   n := usert.fl;
  588.                   g[go,1] := n;
  589.                   usert.fl := 0;
  590.                   usert.fm := 0;
  591.                   writeout(a+lp,usert);
  592.                 END
  593.               ELSE
  594.                 IF usert.fl>n THEN
  595.                   BEGIN
  596.                     usert.fl := usert.fl-n;
  597.                     writeout(a+lp,usert);
  598.                   END;
  599.               g[go,0] := b;
  600.               readin(b+lp,usert);
  601.               IF usert.fl=0 THEN
  602.                   BEGIN
  603.                     usert.fl := n;
  604.                     usert.fm := -1;
  605.                     writeout(b+lp,usert);
  606.                   END
  607.               ELSE
  608.                 BEGIN
  609.                   p := usert.fm;
  610.                   IF p=-1 THEN
  611.                     BEGIN
  612.                       usert.fl := usert.fl+n;
  613.                       writeout(b+lp,usert);
  614.                     END
  615.                   ELSE
  616.                     BEGIN
  617.                       l := 0;
  618.                       k := 0;
  619.                       REPEAT
  620.                         v := RANDOM(2)+1;
  621.                         IF v=1 THEN
  622.                           l := l+1
  623.                         ELSE
  624.                           k := k+1;
  625.                       UNTIL (l>=usert.fl) OR (k>=g[go,1]);
  626.                       if p>1 then begin
  627.                         readin(p,userr);
  628.                         message(p,-1,l,0);
  629.                       end;
  630.                       if p < -10 then
  631.                       begin
  632.                         seek(teams,abs(p)-10);
  633.                         read(teams,tteams);
  634.                         t1:=1;
  635.                         repeat
  636.                           t1:=t1+1;
  637.                           readin(t1,userz);
  638.                         until ((userz.fa = tteams.captain) or (t1>150));
  639.                         if t1<150 then
  640.                         begin
  641.                         userr := userz;
  642.                         addmsg('The Ferrengi attacked '+tteams.captain+'''s team!');
  643.                          ssm(t1,'The Ferrengi destroyed '+cstr(l)+
  644.                           ' of your team''s fighters in sector '+cstr(b));
  645.                         sysoplog('The Ferrengi munched '+cstr(l)+
  646.                         ' of team '+cstr(abs(p)-10)+'''s depl. fighters in sector '+cstr(b));
  647.                         end;
  648.                       end;
  649.                       IF l<usert.fl THEN
  650.                         BEGIN
  651.                           addmsg(userr.fa+' valiantly fought off the Ferrengi!');
  652.                           g[go,0] := 0;
  653.                           g[go,1] := 0;
  654.                           usert.fl := usert.fl-l;
  655.                           writeout(b+lp,usert);
  656.                           sysoplog('      Group '+cstr(go)+' --> Sector '
  657.                                +cstr(b)+'('+userr.fa+'):');
  658.                           sysoplog(' lost '+cstr(k)+
  659.                                ', dstrd '+cstr(l)+' (Ferrengi ftrs lose battle)');
  660.                         END
  661.                       ELSE
  662.                         BEGIN
  663.                         addmsg('The Ferrengi destroyed '+userr.fa+'''s fighters!');
  664.                           usert.fl := n-k;
  665.                           usert.fm := -1;
  666.                           writeout(b+lp,usert);
  667.                           n := n-k;
  668.                           g[go,1] := n;
  669.                           sysoplog('      Group '+cstr(go)+' --> Sector '
  670.                                +cstr(b)+'('+userr.fa+'):');
  671.                           sysoplog(' lost '+cstr(k)+
  672.                                ', dstrd '+cstr(l)+' (Player ftrs lose battle)');
  673.                         END;
  674.                     END;
  675.                 END;
  676.             END;
  677.       END;
  678. END;
  679.  
  680. PROCEDURE maint;
  681.  
  682. VAR
  683.     ttn,ijk,
  684.     i,p,l,m,a,l2,
  685.     e1,v,s1,r,go,
  686.     b1,g1,sc1,t1     : INTEGER;
  687.     active,
  688.     done,done1       : BOOLEAN;
  689.     x                : smr;
  690.     smg2             : FILE OF smr;
  691. BEGIN
  692.   writeln('TradeWars 2001 Daily Maintence program');
  693.   writeln('Running.....');
  694.   nl;
  695.   sysoplog(' ');
  696.   sysoplog('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');
  697.   sysoplog(time+' '+date+'   : TW Maintence program ran');
  698.   sysoplog('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');
  699.  
  700.   readin(1,usert);
  701.   l2 := usert.fk;
  702.   nl;
  703.   getdate;
  704.   l2 := d-l2;
  705.   FOR p:=2 TO lp DO
  706.     BEGIN
  707.       readin(p,usert);
  708.       IF usert.fb<=l2 THEN
  709.         IF (usert.fc<>0) AND (usert.fm>0) THEN
  710.           BEGIN
  711.             sysoplog('  - '+usert.fa+' deleted from game');
  712.             delete(p);
  713.           END;
  714.     END;
  715.  
  716.   ASSIGN(smg2,'tradewar\twsmf2.dat');
  717.   REWRITE(smg2);
  718.   (*$I-*)
  719.   RESET(smg); (*$I+*)
  720.   IF IORESULT=0 THEN
  721.     BEGIN
  722.       i := 0;
  723.       IF i<=FILESIZE(smg)-1 THEN
  724.         BEGIN
  725.           SEEK(smg,i);
  726.           READ(smg,x);
  727.         END;
  728.       WHILE (i<FILESIZE(smg)-1) DO
  729.         BEGIN
  730.           IF x.destin<>-1 THEN
  731.             WRITE(smg2,x);
  732.           i := i+1;
  733.           SEEK(smg,i);
  734.           READ(smg,x);
  735.         END;
  736.       IF x.destin<>-1 THEN
  737.         WRITE(smg2,x);
  738.       CLOSE(smg);
  739.     END;
  740.   CLOSE(smg2);
  741.   ERASE(smg);
  742.   RENAME(smg2,'tradewar\twsmf.dat');
  743.  
  744.  
  745.  
  746.  
  747.   ASSIGN(teams,'tradewar\twteam.dat');
  748.   RESET(teams);
  749.   for ttn := 1 to 50 do
  750.     begin
  751.       active := false;
  752.       seek(teams,ttn);
  753.       read(teams,tteams);
  754.       if tteams.name <> '' then
  755.       begin
  756.         for ijk := 2 to lp do
  757.         begin
  758.           readin(ijk,userz);
  759.           if (userz.fr = ttn) and (userz.fm <> 0) then active := true;
  760.         end;
  761.         if not active then
  762.         begin
  763.           for ijk := 2 to lp do
  764.           begin
  765.             readin(ijk,userz);
  766.             if userz.fr = ttn then
  767.             begin
  768.               userz.fr := 0;
  769.               writeout(ijk,userz);
  770.             end;
  771.           end;
  772.           for ijk := lp+1 to ls do
  773.           begin
  774.             readin(ijk,userz);
  775.             if (abs(userz.fm)-10 = ttn) and (userz.fm < 0) then
  776.               begin
  777.                 userz.fl := 0;
  778.                 userz.fm := 0;
  779.                 writeout(ijk,userz);
  780.               end;
  781.           end;
  782.           sysoplog('Maintenance disbanded team '+tteams.name);
  783.           seek(teams,ttn);
  784.           read(teams,tteams);
  785.           tteams.name := '';
  786.           tteams.captain := '';
  787.           tteams.datemade := '        ';
  788.           tteams.rank := 0;
  789.           tteams.kills := 0;
  790.           rteams := tteams;
  791.           seek(teams,ttn);
  792.           write(teams,tteams);
  793.         end;
  794.       end;
  795.     end;
  796. reset(teams);
  797.  
  798.   writeln('The Ferrengi advance across the Disputed Zone... ');
  799.   sysoplog('   Ferrengi report:');
  800.   FOR l:=1 TO 9 DO
  801.     BEGIN
  802.       readin(l+lp,usert);
  803.       g[l,0] := usert.ft;
  804.       write(g[l,0],' ');
  805.       g[l,1] := 0;
  806.     END;
  807.   FOR l:=1 TO 8 DO
  808.     FOR m:=l+1 TO 9 DO
  809.       IF g[l,0]=g[m,0] THEN
  810.         g[m,0] := 0;
  811.   go := 0;
  812.   FOR l:=1 TO 9 DO
  813.     IF g[l,0]<>0 THEN                (* IF LOCATION <> 0 *)
  814.       BEGIN
  815.         readin(g[l,0]+lp,usert);     (* READ IN SECTOR OF GROUP *)
  816.         IF usert.fm=-1 THEN          (* IF CABAL FIGHTERS *)
  817.           BEGIN
  818.             writeln('Group ',l,' shows ',usert.fl,' fighters in sector ',g[l,0]);
  819.             go := go+usert.fl;       (*  GO=total # OF FIGHTERS. *)
  820.             g[l,1] := usert.fl;
  821.           END;
  822.  
  823.       END;
  824.  
  825.   writeln('total of fighters in sector records is ',go);
  826.   readin(1,usert);                   (* read system record *)
  827.   r := usert.fr;                     (* r is regen amount *)
  828.   IF go<2000-r THEN                  (* if current + regen < 2000, E1 = regen *)
  829.     e1 := r
  830.   ELSE
  831.     BEGIN
  832.       e1 := 2000-go;                 (* E1 = current+regen which = 2000 *)
  833.       IF e1<0 THEN
  834.         e1 := 0;                     (* at limit, no regen at all *)
  835.     END;                             (* E1 now has amount to add *)
  836.   movecabal(2,83,85);                (* MOVE GROUP 2 TO SECTOR 85 *)
  837.   readin(85+lp,usert);               (* read # of cabal in group 1 in sect 85 *)
  838.   IF usert.fm<>-1 THEN               (* if fighters don't belong to the Ferrengi *)
  839.     BEGIN
  840.       g[1,1] := 1000;                (* put 1000 fighters in grp 1 *)
  841.       usert.fm := -1;                (* sector record says ferrengi *)
  842.       usert.fl := 1000;              (* sector record has 1000 fighters *)
  843.       writeout(85+lp,usert);         (* write it *)
  844.     END;
  845.   a := usert.fl;                     (* a is num of fighters in sector *)
  846.   usert.fl := usert.fl+e1;           (* sect_rec = old num + regen amount *)
  847.   writeout(85+lp,usert);             (* write it *)
  848.   s1 := g[1,1]+g[2,1]+e1;            (* S1 is total of fighters in grp1, 2 + regen *)
  849.   IF s1<1500 THEN                    (* if total less than 1500, E1 = 1 *)
  850.     e1 := 1
  851.   ELSE
  852.     e1 := 0;
  853.   IF s1<1000 THEN                    (* if total less than 1000 ... *)
  854.     BEGIN
  855.       g[1,1] := s1;                  (* group 1 gets all of them *)
  856.       g[2,0] := 0;                   (* group 2 gets erased *)
  857.       g[2,1] := 0;                   (* group 2 gets erased *)
  858.     END
  859.   ELSE                               (* if total greater than 1000  *)
  860.     BEGIN
  861.       g[1,1] := 1000;                (* group 1 gets 1000 fighters *)
  862.       g[2,1] := s1-1000;             (* group 2 gets total less 1000 *)
  863.       g[2,0] := 85;                  (* put em in 85 *)
  864.     END;
  865.   movecabal(2,85,83);                (* ' MOVE GROUP 2 TO SECTOR 83 *)
  866. writeln('S1 is '+cstr(s1));
  867.  
  868.   FOR g1:=3 TO 5  DO                 (* ' MOVE GROUP TYPE II FIGHTERS *)
  869.     BEGIN
  870.       WRITELN(g1);
  871.       done := FALSE;
  872.       done1 := FALSE;
  873.       REPEAT
  874.         IF ((g[g1,1]<>0) AND (g[g1,0]<>0)) THEN
  875.             BEGIN
  876.               done := TRUE;
  877.               REPEAT
  878.                 readin(g1+lp,usert);
  879.                 IF (g[g1,0]=usert.fq) OR (usert.fq=0) or done1 THEN
  880.                   BEGIN
  881.                     picksec(v);
  882.                     writeln('New destination made for group '+cstr(g1)+', sector '+cstr(v));
  883.                     usert.fq := v;
  884.                     writeout(g1+lp,usert);
  885.                   END;
  886.               UNTIL (g[g1,0]<>usert.fq) AND (usert.fq<>0);
  887.               IF (g[g1,1]<50) OR (g[g1,1]>100) THEN
  888.                 BEGIN
  889.                   usert.fq := 83;
  890.                   writeout(g1+lp,usert);
  891.                 END;
  892.               IF e1=1 THEN
  893.                 BEGIN
  894.                   usert.fq := 85;
  895.                   writeout(g1+lp,usert);
  896.                 END;
  897.               shortest(g[g1,0],usert.fq);
  898.               IF s[g[g1,0],1]<>0 THEN
  899.               begin
  900.               writeln('Moving group '+cstr(g1)+' from sect '+cstr(g[g1,0])+' to sect '+cstr(s[g[g1,0],1]));
  901.                   movecabal(g1,g[g1,0],s[g[g1,0],1]);
  902.               end;
  903.                   (*' Move 1 step toward goal*)
  904.             END
  905.           ELSE
  906.             IF g[2,1]>=600 THEN
  907.               BEGIN
  908.                 writeln('Group '+cstr(g1)+' created with 100 fighters...');
  909.                 g[g1,1] := 100;
  910.                 g[2,1] := g[2,1]-100;
  911.                 writeln('Group 2 in 83 now has '+cstr(g[2,1]));
  912.                 done1 := TRUE;
  913.                 g[g1,0] := 83;       (* ' Create a group II group*)
  914.               END
  915.             ELSE done := TRUE;
  916.       UNTIL ((g[g1,0]<=0) OR (g[g1,0]>=8) OR (g[g1,1]=0)) AND done;
  917.     END;
  918.   rank(p);
  919.   IF p<1 THEN
  920.     BEGIN
  921.       sc1 := 0;
  922.       t1 := 0;
  923.     END
  924.   ELSE
  925.     BEGIN
  926.       t1 := p;
  927.       readin(t1,usert);
  928.       sc1 := usert.ff;
  929.        IF usert.fv < 2500 THEN
  930.          BEGIN
  931.            sc1 := 0;
  932.            t1 := 0;
  933.          END;
  934.     END;
  935.   IF (sc1=0) OR (t1=0) THEN
  936.     BEGIN
  937.       sc1 := 83;
  938.       t1 := 0;
  939.     END;
  940.  
  941.   FOR g1:=6 TO 9  DO                 (* ' Move group type III fighters *)
  942.     BEGIN
  943.       done := FALSE;
  944.       done1 := FALSE;
  945.       WRITELN(g1);
  946.       REPEAT
  947.         IF ((g[g1,1]<>0) AND (g[g1,0]<>0)) OR done THEN
  948.           BEGIN
  949.  
  950.             IF g1 = 9 THEN
  951.               b1 := sc1
  952.             ELSE
  953.               REPEAT                 (* This is where It hangs!?! *)
  954.                 picksec(v);
  955.                 b1 := v;
  956.               UNTIL (v<>g[g1,0]) AND (v>1);    (* This should stop hang...*)
  957.  
  958.  
  959.             IF (g[g1,1]<20) OR (g[g1,1]>50) THEN
  960.               b1 := 83;
  961.             IF e1=1 THEN
  962.               b1 := 85;
  963.             shortest(g[g1,0],b1);
  964.             done1 := FALSE;
  965.             IF s[g[g1,0],1]<>0 THEN
  966.               BEGIN
  967.                 REPEAT
  968.                   IF (g[g1,1]<0) OR (g[g1,0]=0) THEN
  969.                     BEGIN
  970.                       g[g1,0] := 0;
  971.                       g[g1,1] := 0;
  972.                       done1 := TRUE;
  973.                     END
  974.                   ELSE
  975.                     IF (g1<>9) OR (g[g1,0]<>sc1) THEN
  976.                       BEGIN
  977.                         movecabal(g1,g[g1,0],s[g[g1,0],1]);
  978.                         IF (g[g1,1]<0) OR (g[g1,0]=0) THEN
  979.                           BEGIN
  980.                             g[g1,0] := 0;
  981.                             g[g1,1] := 0;
  982.                             done1 := TRUE;
  983.                           END
  984.                         ELSE
  985.                           BEGIN
  986.                             readin(g[g1,0]+lp,usert);
  987.                             IF (g1<>9) AND (usert.fi<>0) THEN
  988.                               BEGIN
  989.                                 p := usert.fi;
  990.                                 cattack(g1,p,20);
  991.                               END;
  992.                           END;
  993.                       END;
  994.                 UNTIL (g[g1,0]=b1) OR done1;
  995.                 IF (t1<>0) AND (g1=9) AND (NOT done1) THEN
  996.                   cattack(g1,t1,g[g1,1]);
  997.                 done1 := TRUE;
  998.               END
  999.               ELSE
  1000.                 done1 := TRUE;
  1001.           END
  1002.         ELSE
  1003.           IF g[2,1]>=550 THEN
  1004.             BEGIN
  1005.               g[g1,1] := 50;
  1006.               g[2,1] := g[2,1]-50;
  1007.               g[g1,0] := 83;
  1008.               done := TRUE;
  1009.             END
  1010.           ELSE
  1011.             done1 := TRUE;
  1012.         IF (g[g1,0]>0) AND (g[g1,0]<8) AND (g[g1,1]<>0) THEN
  1013.           BEGIN
  1014.             s1 := 85;
  1015.             done := TRUE;
  1016.           END;
  1017.       UNTIL ((g[g1,0]<=0) OR (g[g1,0]>=8) OR (g[g1,1]=0)) AND done1;
  1018.     END;
  1019.   FOR l:=1 TO 9 DO
  1020.     BEGIN
  1021.       readin(lp+l,usert);
  1022.       usert.ft := g[l,0];
  1023.       writeout(lp+l,usert);
  1024.     END;
  1025.   readin(1,usert);
  1026.   usert.fl := d;
  1027.   writeout(1,usert);
  1028. END;
  1029.  
  1030. procedure maintopen;
  1031.  
  1032. var
  1033.    I,
  1034.    x : integer;
  1035.    hold : array[1..10] of string[160];
  1036.  
  1037.  
  1038. begin
  1039.   reset(msger);
  1040.   for i := 1 to 10 do hold[i] := '*';
  1041.   x := 0;
  1042.   repeat
  1043.     readln(msger);
  1044.     x := x + 1;
  1045.   until(eof(msger));
  1046.   reset(msger);
  1047.   x := x-2;
  1048.   readln(msger);
  1049.   readln(msger);
  1050.   if x > 10 then
  1051.     for I := 1 to (x-10) do readln(msger);
  1052.   x := 1;
  1053.   repeat
  1054.     readln(msger,hold[x]);
  1055.     x := x + 1;
  1056.   until ((x=11) or (eof(msger)));
  1057.   rewrite(msger);
  1058.   writeln(msger,'   -=-=-  Ravenloft Trade Wars Daily Journal for '+date+' -=-=- ');
  1059.   writeln(msger,' ');
  1060.   for x := 1 to 10 do
  1061.   begin
  1062.     if (hold[x] <> '*') then
  1063.       writeln(msger,hold[x]);
  1064.   end;
  1065.   writeln(msger,'/\/\/\/\/  The Ferrengi moved at '+time+', on '+date);
  1066.   reset(msger);
  1067.   append(msger);
  1068. end;
  1069.  
  1070.  
  1071.  
  1072. PROCEDURE INIT;
  1073.  
  1074.   VAR
  1075.       DONE : BOOLEAN;
  1076. BEGIN
  1077.   ASSIGN(MSGER,'tradewar\TWOPENG.DAT');
  1078.   RESET(MSGER);
  1079.   APPEND(MSGER);
  1080.   ASSIGN(SMG,'tradewar\TWSMF.DAT');
  1081.   ENDED := FALSE;
  1082.   ASSIGN(USERF,'tradewar\TWDATA.DAT');
  1083.   RESET(USERF);
  1084.   READIN(1,USERR);
  1085.   WITH USERR DO
  1086.     BEGIN
  1087.       AY := FC;
  1088.       TT := FD;
  1089.       LP := FE;
  1090.       LS := FF;
  1091.       LT1 := FG;
  1092.       LL1 := FO;
  1093.     END;
  1094.   GETDATE;
  1095.   readin(1,userr);
  1096.   userr.fl := d;
  1097.   writeout(1,userr);
  1098. END;
  1099.  
  1100.  
  1101. begin
  1102.   iport;
  1103.   init;
  1104.   maintopen;
  1105.   maint;
  1106.   sysoplog('-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');
  1107.   close(msger);
  1108.   close(smg);
  1109.   close(userf);
  1110.   close(teams);
  1111.   return;
  1112. END.
  1113.